{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit ItImport;

interface

uses
  Classes, SysUtils, Profile, Xdom_3_2, ItParser, ZipReader, MiscUtils,
  ItCommon, XmlRulesUtils, cUnicodeCodecsWin32, TestCore, TestUtils;

type
  TTestXmlReadEvent = procedure(Root: TXmlElement; Parser: TTestParser) of object;

function ImportFromItStream(Input: TStream): TTestDocument;
procedure ImportFragmentFromItStream(Input: TStream; const OnRead: TTestXmlReadEvent);

procedure BytesToModifierList(const Bytes: String; List: TModifierList);
function BytesToProfile(const Bytes: String): TProfile;

implementation

type
  TZipResourceResolver = class(TResourceResolver)
  private
    FReader: TZipReader;
  public
    constructor Create(Reader: TZipReader);
    procedure OpenFile(const FileName: String); override;
    function GetFileStream: TStream; override;
    procedure CloseFile; override;
  end;

  TTreeBuilder = class(TXmlCustomHandler)
  private
    FElements: TXmlElementList;
    FRoot: TXmlElement;
    FOpenElements: TXmlElementList;
    procedure ProcessStartElement(s: TXmlStartElementSignal);
    procedure ProcessEndElement(s: TXmlEndElementSignal);
    procedure ProcessAttribute(s: TXmlAttributeSignal);
    procedure ProcessPCData(s: TXmlPCDATASignal);
    procedure ProcessCompleted(s: TXmlCompletedSignal);
    function CurrentElement: TXmlElement;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure processSignal(const Signal: TXmlSignal); override;

    property Root: TXmlElement read FRoot;
  end;

  TTestDocumentReader = class
  private
    FTarget: TTestDocument;
    procedure Read(Root: TXmlElement; Parser: TTestParser);
  public
    constructor Create(Target: TTestDocument);
  end;

  TModifierListReader = class
  private
    FTarget: TModifierList;
    procedure Read(Root: TXmlElement; Parser: TTestParser);
  public
    constructor Create(Target: TModifierList);
  end;

  TProfileReader = class
  private
    FTarget: TProfile;
    procedure Read(Root: TXmlElement; Parser: TTestParser);
  public
    constructor Create(Target: TProfile);
  end;

procedure Ensure(Condition: Boolean);
begin
  if not Condition then
    raise Exception.Create('XML parsing error.');
end;

function ImportFromItStream(Input: TStream): TTestDocument;
var
  Reader: TTestDocumentReader;
begin
  Result := TTestDocument.Create;
  try
    Reader := TTestDocumentReader.Create(Result);
    try
      ImportFragmentFromItStream(Input, Reader.Read);
    finally
      Reader.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;

procedure ImportFragmentFromItStream(Input: TStream; const OnRead: TTestXmlReadEvent);
var
  ArchiveReader: TZipReader;
  TestStream: TMemoryStream;
  XmlSource: TXmlInputSource;
  XmlReader: TXmlStandardDocReader;
  Builder: TTreeBuilder;
  Resolver: TResourceResolver;
  Parser: TTestParser;
begin
  ArchiveReader := TZipReader.Create(Input);
  try
    Builder := TTreeBuilder.Create(nil);
    try
      TestStream := TMemoryStream.Create;
      try
        ArchiveReader.OpenEntry(IT_TEST_FILE_NAME);
        CopyStreamTail(ArchiveReader.EntryStream, TestStream);
        ArchiveReader.CloseEntry;
        TestStream.Seek(0, soFromBeginning);

        XmlSource := TXmlInputSource.Create(TestStream, '', '', 4096, nil, TRUE,
          0, 0, 0, 0, 1, lrPass);
        try
          XmlReader := TXmlStandardDocReader.Create(nil);
          try
            XmlReader.NextHandler := Builder;
            try
              XmlReader.Parse(XmlSource, FALSE);
            except on E: EdomException do
              Ensure(FALSE); { Replace cryptic XML error messages (like "Signal Processing
                Exception") with our own one. }
            end;
          finally
            XmlReader.Free;
          end;
        finally
          XmlSource.Free;
        end;
      finally
        TestStream.Free;
      end;

      Resolver := TZipResourceResolver.Create(ArchiveReader);
      try
        Parser := TTestParser.Create;
        try
          Parser.Resolver := Resolver;
          OnRead(Builder.Root, Parser);
        finally
          Parser.Free;
        end;
      finally
        Resolver.Free;
      end;
    finally
      Builder.Free;
    end;
  finally
    ArchiveReader.Free;
  end;
end;

procedure BytesToModifierList(const Bytes: String; List: TModifierList);
var
  Input: TStringStream;
  Reader: TModifierListReader;
begin
  Input := TStringStream.Create(Bytes);
  try
    Reader := TModifierListReader.Create(List);
    try
      ImportFragmentFromItStream(Input, Reader.Read);
    finally
      Reader.Free;
    end;
  finally
    Input.Free;
  end;
end;

function BytesToProfile(const Bytes: String): TProfile;
var
  Input: TStringStream;
  Reader: TProfileReader;
begin
  Result := TProfile.Create;
  try
    Input := TStringStream.Create(Bytes);
    try
      Reader := TProfileReader.Create(Result);
      try
        ImportFragmentFromItStream(Input, Reader.Read);
      finally
        Reader.Free;
      end;
    finally
      Input.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;

{ TTestDocumentReader }

procedure TTestDocumentReader.Read(Root: TXmlElement; Parser: TTestParser);
begin
  Parser.DoTestDocument(Root, FTarget);
end;

constructor TTestDocumentReader.Create(Target: TTestDocument);
begin
  inherited Create;
  FTarget := Target;
end;

{ TModifierListReader }

constructor TModifierListReader.Create(Target: TModifierList);
begin
  inherited Create;
  FTarget := Target;
end;

procedure TModifierListReader.Read(Root: TXmlElement; Parser: TTestParser);
var
  c: TXmlElement;
begin
  c := Root.GetElement(ELEM_MODIFIERS);
  if c <> nil then
    Parser.DoModifiers(c, FTarget);
end;

{ TProfileReader }

constructor TProfileReader.Create(Target: TProfile);
begin
  inherited Create;
  FTarget := Target;
end;

procedure TProfileReader.Read(Root: TXmlElement; Parser: TTestParser);
begin
  Parser.DoProfile(Root.FindElement(ELEM_PROFILE), FTarget);
end;

{ TZipResourceResolver }

procedure TZipResourceResolver.CloseFile;
begin
  FReader.CloseEntry;
end;

constructor TZipResourceResolver.Create(Reader: TZipReader);
begin
  inherited Create;
  FReader := Reader;
end;

function TZipResourceResolver.GetFileStream: TStream;
begin
  Result := FReader.EntryStream;
end;

procedure TZipResourceResolver.OpenFile(const FileName: String);
begin
  FReader.OpenEntry(FileName);
end;

{ TTreeBuilder }

constructor TTreeBuilder.Create(Owner: TComponent);
begin
  inherited;
  FElements := TXmlElementList.Create;
  FOpenElements := TXmlElementList.Create(FALSE);
end;

function TTreeBuilder.CurrentElement: TXmlElement;
begin
  Ensure(FOpenElements.Count > 0);
  Result := FOpenElements.Last;
end;

destructor TTreeBuilder.Destroy;
begin
  FreeAndNil(FOpenElements);
  FreeAndNil(FElements);
  inherited;
end;

procedure TTreeBuilder.ProcessAttribute(s: TXmlAttributeSignal);
var
  v: WideString;
  Err: TXmlErrorType;
begin
  CalcNormalizedAttrValue(s.Value, v, Err, FALSE, lrPass);
  Ensure(Err = ET_NONE);
  CurrentElement.AddAttr(UTF8Encode(s.Name), UTF8Encode(v));
end;

procedure TTreeBuilder.ProcessCompleted(s: TXmlCompletedSignal);
begin
  Ensure(FOpenElements.Count = 0);
  Ensure(FRoot <> nil);
end;

procedure TTreeBuilder.ProcessEndElement(s: TXmlEndElementSignal);
begin
  Ensure(SameText(CurrentElement.Name, s.TagName));
  FOpenElements.Delete(FOpenElements.Count-1);
end;

procedure TTreeBuilder.ProcessPCData(s: TXmlPCDATASignal);
begin
  Ensure(IsXmlS(s.Data));
end;

procedure TTreeBuilder.processSignal(const Signal: TXmlSignal);
var
  Ignore: Boolean;
begin
  if Signal is TXmlStartElementSignal then
    ProcessStartElement(TXmlStartElementSignal(Signal))
  else if Signal is TXmlEndElementSignal then
    ProcessEndElement(TXmlEndElementSignal(Signal))
  else if Signal is TXmlAttributeSignal then
    ProcessAttribute(TXmlAttributeSignal(Signal))
  else if Signal is TXmlPCDATASignal then
    ProcessPCData(TXmlPCDATASignal(Signal))
  else if Signal is TXmlCompletedSignal then
    ProcessCompleted(TXmlCompletedSignal(Signal))
  else
  begin
    Ignore := (Signal is TXmlAbortedSignal)
      or (Signal is TXmlStartDocumentSignal)
      or (Signal is TXmlCommentSignal)
      or (Signal is TXmlProcessingInstructionSignal);
    Ensure(Ignore);
  end;
end;

procedure TTreeBuilder.ProcessStartElement(s: TXmlStartElementSignal);
var
  e: TXmlElement;
begin
  e := TXmlElement.Create(s.TagName);
  FElements.AddSafely(e);
  if FRoot = nil then
    FRoot := e
  else
    CurrentElement.AddElement(e);
  FOpenElements.Add(e);
end;

end.
